home *** CD-ROM | disk | FTP | other *** search
/ The Amiga Classic Collection / The Amiga Classic Collection - Disc 1.iso / Education / ED05-AmRadio1.DMS / ED05-AmRadio1.adf / Logging / WPX / Sort.It (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-01-19  |  4KB  |  110 lines
  1. '###########################################################################
  2. '#                                                                         #
  3. '#               W P X   CALLSIGN SORTING ROUTINE                          #
  4. '#                               by                                        #
  5. '#                    Bj. Madsen  -+-  VE5FX                               #
  6. '#                           Jan. 1987                                     #
  7. '#                                                                         #
  8. '###########################################################################
  9. '
  10. '  This program will read a previously-created file of callsigns from disk to
  11. '  memory.  It will then sort them into CQ Magazines required order using
  12. '  letters smaller than numbers, and a 0 larger than a 9.  Once a file has
  13. '  been sorted, it is written out again under the same or different name.
  14. '
  15. CLEAR ,10000
  16.  
  17. CLEAR ,50000
  18. DIM CS$(3000)
  19. CLS : N=1 
  20.  LINE (0,0)-(640,5),3,BF
  21.  LINE (0,0)-(10,200),3,BF
  22.  LINE (607,0)-(617,200),3,BF
  23.  LINE (0,181)-(617,186),3,BF
  24.  LINE (0,30)-(640,35),3,b
  25.  PAINT (20,10),2,3:PAINT (20,33),1,3
  26.  COLOR 3,2
  27. LOCATE 3,20:PRINT "V E 5 F X  -  Callfile Sort Program"
  28.  COLOR 3,0
  29. LOCATE 10,15 :INPUT"What file do you want to READ FROM";INFILE$
  30.  LINE (50,45)-(570,57),3,BF
  31.  LOCATE 7,13 :COLOR 0,3:PRINT"INFILE: ";INFILE$
  32. GOSUB CLEARIT
  33. LOCATE 10,15 :COLOR 3,0 :INPUT"What file do you wish to WRITE TO..";OUTFILE$
  34. LOCATE 7,53 :COLOR 0,3:PRINT "OUTFILE: ";OUTFILE$
  35.  
  36. OPEN "I",#1,INFILE$
  37.   WHILE NOT EOF(1)
  38.     INPUT #1,CS$(N)
  39.     LET N = N + 1
  40.   WEND
  41.  
  42.   LET N = N - 1
  43. CLOSE : COLOR 1,3
  44. '
  45. LOCATE 7,34 :COLOR 1,3 :PRINT N;"calls"
  46.  
  47. ANOTHER:
  48.   GOSUB CLEARIT
  49.   LOCATE 10,15 :COLOR 3,0 :INPUT"Do you wish to read another input file";a$
  50.   IF LEFT$(a$,1) <> "Y" THEN CONVERTIT
  51.     INPUT"What is the filespec of this file";INFILE$
  52.       OPEN"I",#1,INFILE$
  53.         WHILE NOT EOF(1)
  54.           INPUT #1,CS$(N)
  55.           LET N = N + 1
  56.         WEND
  57.       LET N = N - 1
  58.     CLOSE 
  59.     LOCATE 7,32 :COLOR 1,3 :PRINT N;"calls"
  60.   GOTO ANOTHER      
  61. ' ----------------------------------------- convert callsigns pre-sort
  62. CONVERTIT:
  63.    LOCATE 12,23:COLOR 2,0:PRINT "start converting @ ";TIME$
  64.    GOSUB CLEARIT:LOCATE 10,15:COLOR 3,0:PRINT "Converting callsigns...."
  65.   FOR X = 1 TO N
  66.     FOR I = 1 TO LEN(CS$(X))
  67.       V = ASC(MID$(CS$(X),I,1))
  68.         IF V>47 AND V<58 THEN IF V=48 THEN V=106 :ELSE V=V+48
  69.       MID$(CS$(X),I,1) = CHR$(V)
  70.     NEXT I
  71.   NEXT X
  72. ' ----------------------------------------- sort callsigns into WPX format
  73.  LOCATE 13,23:COLOR 2,0:PRINT "start sorting @ ";TIME$   
  74. SORTIT:
  75.    P=P+1 
  76.   GOSUB CLEARIT:LOCATE 10,15:COLOR 3,0:PRINT "Sorting callsigns....pass #";P
  77.   FLAG = 0
  78.     FOR X = 1 TO N-1
  79.       IF CS$(X) > CS$(X+1) THEN SWAP CS$(X),CS$(X+1) : FLAG = 1
  80.     NEXT X
  81.   IF FLAG <> 0 THEN SORTIT
  82. '----------------------------------------- restore calls to standard format
  83. RESTOREIT:
  84.    LOCATE 14,23:COLOR 2,0:PRINT "Start restoring @ ";TIME$ 
  85.    GOSUB CLEARIT: LOCATE 10,15:COLOR 3,0:PRINT "Restoring callsign format ......."
  86.    FOR X = 1 TO N
  87.      FOR I = 1 TO LEN(CS$(X))
  88.        V=ASC(MID$(CS$(X),I,1))
  89.          IF V>96 THEN IF V=106 THEN V=48 :ELSE V=V-48
  90.        MID$(CS$(X),I,1) = CHR$(V)
  91.      NEXT I
  92.    NEXT X
  93.  
  94. '-----------------------------------------------  write sorted file to disk
  95. GOSUB CLEARIT
  96. LOCATE 10,15: COLOR 3,0 :PRINT "Writing ";OUTFILE$;" to disk ......"
  97.  OPEN OUTFILE$ FOR OUTPUT AS #1
  98.    FOR X = 1 TO N
  99.      PRINT #1,CS$(X)
  100.    NEXT X
  101.  CLOSE #1 
  102. GOSUB CLEARIT
  103. LOCATE 10,15 :COLOR 3,0 :PRINT "Output file has been created with";N;"calls."
  104. END   
  105.  
  106. CLEARIT:
  107.   COLOR 0,0:LOCATE 10,15:PRINT STRING$(60," ")
  108.   RETURN
  109.   
  110.